Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/kewlpo1a/frmpong.frm

Visual Basic Form | 1999-10-21 | 13.0 KB | 389 lines

VERSION 5.00
Begin VB.Form frmPong
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Pong! ----- 0 / 0"
   ClientHeight    =   5415
   ClientLeft      =   45
   ClientTop       =   615
   ClientWidth     =   5370
   Icon            =   "FRMPONG.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5415
   ScaleWidth      =   5370
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdStart
      Caption         =   "&Start!"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   1560
      TabIndex        =   0
      Top             =   2040
      Width           =   1815
   End
   Begin VB.Shape shpP2
      BackColor       =   &H00000000&
      BackStyle       =   1  'Opaque
      Height          =   135
      Left            =   1680
      Top             =   360
      Width           =   1335
   End
   Begin VB.Shape shpP1
      BackColor       =   &H00000000&
      BackStyle       =   1  'Opaque
      Height          =   135
      Left            =   1680
      Top             =   5160
      Width           =   1335
   End
   Begin VB.Shape shpBall
      BackColor       =   &H000000FF&
      BackStyle       =   1  'Opaque
      Height          =   135
      Left            =   2400
      Shape           =   3  'Circle
      Top             =   2160
      Visible         =   0   'False
      Width           =   135
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileStart
         Caption         =   "&Start!"
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuFilePause
         Caption         =   "&Pause"
         Shortcut        =   ^P
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileResume
         Caption         =   "&Resume"
         Shortcut        =   ^R
         Visible         =   0   'False
      End
      Begin VB.Menu mnuSepe
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
         Shortcut        =   ^X
      End
   End
   Begin VB.Menu mnuSettings
      Caption         =   "&Settings"
      Begin VB.Menu mnuConfig
         Caption         =   "&Keyboard configurations"
      End
      Begin VB.Menu mnuSepe1
         Caption         =   "-"
      End
      Begin VB.Menu mnuSetRounds
         Caption         =   "&No. of Rounds"
      End
      Begin VB.Menu mnuSetBSpeed
         Caption         =   "&Ball Speed"
      End
      Begin VB.Menu mnuSetPSpeed
         Caption         =   "&Paddle Speed"
      End
      Begin VB.Menu mnuSetPLength
         Caption         =   "Paddle &Length"
      End
      Begin VB.Menu mnuSetBSize
         Caption         =   "Ball &Size"
         Begin VB.Menu mnuSetBSizeS
            Caption         =   "&Small"
            Checked         =   -1  'True
         End
         Begin VB.Menu mnuSetBSizeM
            Caption         =   "&Medium"
         End
         Begin VB.Menu mnuSetBSizeL
            Caption         =   "&Large"
         End
      End
   End
   Begin VB.Menu mnunCredits
      Caption         =   "&Credits"
      Begin VB.Menu mnuCredits
         Caption         =   "&Credits"
      End
   End
Attribute VB_Name = "frmPong"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim mx As Integer
Dim my As Integer
Dim mSpeed As Integer
Dim Temp1 As Integer
Dim Temp2 As Integer
Dim StartTime As Long
Dim P1win As Integer
Dim P2win As Integer
Dim Rounds As Integer
Dim BallSpeed As Integer
Dim rcolor As Integer
Dim RNum As Byte
Dim PaddleSpeed As Integer
Dim PaddleLength As Long
Dim BallSize As Byte
Dim YesOK As Boolean
Private Sub cmdStart_Click()
    mnuFileStart.Visible = False
    mnuFilePause.Visible = True
    Me.BorderStyle = 3
    RNum = Int(Rnd * 7)
    mSpeed = 120
    If my < 0 Then
        mx = -60
        my = -60
        shpBall.Top = shpP1.Top - 240
    Else
        mx = 60
        my = 60
        shpBall.Top = shpP2.Top + 240
    End If
    shpBall.BackColor = vbRed
    shpBall.Left = Int(Rnd * (Me.Width - shpBall.Width))
    cmdStart.Visible = False
    shpBall.Visible = True
    StartTime = GetCurrentTime
goagain:
    If YesOK = True Then
        Do Until GetCurrentTime - StartTime >= BallSpeed
            KeyD
            DoEvents
        Loop
        StartTime = GetCurrentTime
        If (shpBall.Left >= shpP1.Left And shpBall.Left <= shpP1.Left + shpP1.Width) Then
            If (shpBall.Top + shpBall.Height) >= shpP1.Top And (shpBall.Top + shpBall.Height) <= shpP1.Top + shpP1.Height Then
                Beep
                my = -my
                If my < 0 Then my = my - 1 Else my = my + 1
                Temp1 = shpBall.Left + shpBall.Width / 2
                Temp2 = shpP1.Left + shpP1.Width / 2
                mx = Temp2 - Temp1
                If Temp1 <> shpP1.Left And Temp1 <> shpP1.Left + shpP1.Width Then
                    mx = mx / 7 * 3
                End If
            End If
        End If

        If (shpBall.Left >= shpP2.Left And shpBall.Left <= shpP2.Left + shpP2.Width) Then
            If shpBall.Top <= (shpP2.Top + shpP2.Height) And shpBall.Top >= shpP2.Top Then
                Beep
                my = -my
                If my < 0 Then my = my - 1 Else my = my + 1
                Temp1 = shpBall.Left + shpBall.Width / 2
                Temp2 = shpP2.Left + shpP2.Width / 2
                mx = Temp2 - Temp1
                If Temp1 <> shpP2.Left And Temp1 <> shpP2.Left + shpP2.Width Then
                    mx = mx / 7 * 3
                End If
            End If
        End If

        If (shpBall.Left >= (Me.Width - shpBall.Width)) Or shpBall.Left <= 0 Then mx = -mx

        If (shpBall.Top >= (Me.Height - shpBall.Height)) Then
            MsgBox "P2 gets a point!"
            P2win = P2win + 1
            Me.Caption = "Pong! ----- " + LTrim$(Str$(P1win)) + " / " + LTrim$(Str$(P2win))
            cmdStart.Visible = True
            If P2win = Rounds Then
                MsgBox "P2 wins!"
                Me.BorderStyle = 2
                Unload Me
                Exit Sub
            End If
            Me.BorderStyle = 2
            Exit Sub
        End If

        If shpBall.Top <= 0 Then
            MsgBox "P1 gets a point!"
            P1win = P1win + 1
            Me.Caption = "Pong! ----- " + LTrim$(Str$(P1win)) + " / " + LTrim$(Str$(P2win))
            cmdStart.Visible = True
                If P1win = Rounds Then
                MsgBox "P1 wins!"
                Me.BorderStyle = 2
                Unload Me
                Exit Sub
            End If
            Me.BorderStyle = 2
            Exit Sub
        End If

        shpBall.Left = shpBall.Left + mx
        shpBall.Top = shpBall.Top + my
        KeyD
    End If
    DoEvents
    GoTo goagain
End Sub
Private Sub Form_Load()
    On Error Resume Next
    Randomize
    If Int(Rnd * 2) = 1 Then
        mx = -60
        my = -60
    Else
        mx = 60
        my = 60
    End If
    P1win = 0
    P2win = 0
    'Instructions
    '''''''''''''
    MsgBox "Welcome to PONG! Code original by " + MyName + "."
    MsgBox "Player 1 controls the bottom paddle with the '" & KeyStr1(0) & "' and '" & KeyStr1(1) & "' buttons to move it left and right respectively." & Chr(13) & _
           "Player 2 controls the top paddle with the '" & KeyStr2(0) & "' and '" & KeyStr2(1) & "' buttons to move it left and right respectively." & Chr(13) & _
           vbTab & "[P.S. These keyboard configurations can be changed anytime by" & vbTab & "]" & Chr(13) & _
           vbTab & "[" & vbTab & "selecting the menu Settings, Keyboard configurations." & vbTab & "]" & Chr(13) & _
           "Thanx for playing, enjoy the game, and may the best man win!!!", vbExclamation, "Instructions"
    'Default settings
    '''''''''''''''''
    PaddleLength = 1335
    BallSpeed = 20
    PaddleSpeed = 8
    Rounds = 3
    shpP1.Width = PaddleLength
    shpP2.Width = PaddleLength
    Me.BorderStyle = 2
    Me.Width = Screen.Width / 2
    Me.Height = Me.Width
    YesOK = True
    Form_Resize
End Sub
Private Sub KeyD()
If GetAsyncKeyState(KeyCode1(0)) <> 0 Then
        shpP1.Left = shpP1.Left - PaddleSpeed
        If shpP1.Left < 0 Then shpP1.Left = 0
End If
If GetAsyncKeyState(KeyCode1(1)) <> 0 Then
    shpP1.Left = shpP1.Left + PaddleSpeed
    If shpP1.Left > (Me.Width - shpP1.Width) Then shpP1.Left = Me.Width - shpP1.Width
End If
If GetAsyncKeyState(KeyCode2(0)) <> 0 Then
    shpP2.Left = shpP2.Left - PaddleSpeed
    If shpP2.Left < 0 Then shpP2.Left = 0
End If
If GetAsyncKeyState(KeyCode2(1)) <> 0 Then
    shpP2.Left = shpP2.Left + PaddleSpeed
    If shpP2.Left > (Me.Width - shpP2.Width) Then shpP2.Left = Me.Width - shpP2.Width
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If MsgBox("Are you sure you want to exit?", vbExclamation + vbDefaultButton2 + vbYesNo + vbSystemModal, "Exit?") = vbNo Then Cancel = 1
End Sub
Private Sub Form_Resize()
    shpP1.Top = Me.Height - 1080
    shpP1.Left = Me.Width / 2 - shpP1.Width / 2
    shpP2.Left = Me.Width / 2 - shpP2.Width / 2
    cmdStart.Left = Me.Width / 2 - cmdStart.Width / 2
    cmdStart.Tag = Me.Height / 2 - cmdStart.Height / 2
End Sub
Private Sub Form_Unload(Cancel As Integer)
    YesOK = False
End Sub
Private Sub mnuConfig_Click()
    frmConfigurations.Show 1
End Sub
Private Sub mnuCredits_Click()
    ShellAbout Me.hwnd, App.Title & " " & App.Major & "." & App.Minor, "By: " & MyName & vbCrLf & "[e-mail]", Me.Icon
End Sub
Private Sub mnuFileExit_click()
    Unload Me
End Sub
Private Sub mnuFilePause_Click()
        YesOK = False
        mnuFilePause.Visible = False
        mnuFileResume.Visible = True
        Me.Caption = "Pong! ----- Paused. Press Ctrl+R to resume play."
End Sub
Private Sub mnuFileResume_Click()
        YesOK = True
        mnuFilePause.Visible = True
        mnuFileResume.Visible = False
        Me.Caption = "Pong! ----- " + LTrim$(Str$(P1win)) + " / " + LTrim$(Str$(P2win))
End Sub
Private Sub mnuFileStart_Click()
    cmdStart_Click
End Sub
Private Sub mnuSetBSizeL_Click()
    mnuSetBSizeS.Checked = False
    mnuSetBSizeM.Checked = False
    mnuSetBSizeL.Checked = True
    shpBall.Height = 360
    shpBall.Width = 360
End Sub
Private Sub mnuSetBSizeM_Click()
    mnuSetBSizeS.Checked = False
    mnuSetBSizeM.Checked = True
    mnuSetBSizeL.Checked = False
    shpBall.Height = 240
    shpBall.Width = 240
End Sub
Private Sub mnuSetBSizeS_Click()
    mnuSetBSizeS.Checked = True
    mnuSetBSizeM.Checked = False
    mnuSetBSizeL.Checked = False
    shpBall.Height = 120
    shpBall.Width = 120
End Sub
Private Sub mnuSetBSpeed_Click()
On Error GoTo bagain
bagain:
    BallSpeed = Int(Val(InputBox$("Ball Speed? [Default:20 ; The less the faster the ball is]" & Chr(13) & "[1-100]", "Ball Speed", "20")))
    If BallSpeed > 100 Or BallSpeed <= 0 Then
        MsgBox "Speed error!", vbExclamation, "Speed error!"
        GoTo bagain
    End If
End Sub
Private Sub mnuSetPLength_Click()
On Error GoTo cagain
cagain:
    PaddleLength = Int(Val(InputBox$("Paddle Length? [Default:1335 ; The more the longer the paddles are]" & Chr(13) & "Make it more for beginners.", "Paddle Length", PaddleLength)))
    If PaddleLength > 10000 Or PaddleLength < 50 Then
        MsgBox "Paddle Length error!", vbExclamation, "Paddle Length error!"
        GoTo cagain
    End If
    shpP1.Width = PaddleLength
    shpP2.Width = PaddleLength
End Sub
Private Sub mnuSetPSpeed_Click()
On Error GoTo gagain
gagain:
    PaddleSpeed = Int(Val(InputBox$("Paddle Speed? [Default:8 ; The more the faster the paddles move]" & Chr(13) & "Make it more for slower computers.", "Paddle Speed", PaddleSpeed)))
    If PaddleSpeed > 100 Or PaddleSpeed <= 0 Then
        MsgBox "Speed error!", vbExclamation, "Speed error!"
        GoTo gagain
    End If
End Sub
Private Sub mnuSetRounds_Click()
On Error GoTo ragain
ragain:
    Rounds = Int(Val(InputBox$("How many points to win? [1-10]", "Points?", Rounds)))
    If Rounds > 10 Or Rounds <= 0 Then
        MsgBox "Rounds error!", vbExclamation, "Rounds error!"
        GoTo ragain
    End If
End Sub